TITL DAI FIRMWARE 3E6FD-3E858  V1.0  Rev.1
        ORG   :E6FD
*
*
*
*******************************
* FIND VARIABLE NAME IN INPUT *
*******************************
*
* Checks if 1st character is a upper case one.
* Reads the input (starting with character after
* C) till it finds a non-alphanumeric character
* (number or upper case). On a carry CALL, it also
* accepts %, ! or $ at the end. Blanks are not
* ignored and not accepted.
*
* Entry: C :  Input position.
* Exit:  B :  Entry C.
*        C :  Points to 1st character not accepted.
*        D :  Count of 1st character not accepted.
*             (1st character read has count 1).
*        A,E: 1st non-alphanumeric character read.
*        HL preserved. F corrupted.
*
RDID    PUSH  PSW       Preserve CY-flag
        MOV   B,C
        MVI   D,:00     Init count
L3E110  INR   D         Count +1
        INR   C         Line pos +1
        MOV   A,D       Count in A
        CPI   :0F       Max 14 char for a name
        JC    :E70A
        DCR   D         Skip last char if > 14
L3E111  CALL  :DDE0     Get char from line
        CALL  :DE09     Check if nr or upper case
        JC    :E701     Get next char if O.K.
        CALL  :DDE0     Get 1st non-alphanum.char
 REM from line
        MOV   E,A       Store it in E
        POP   PSW       Get CY-flag back
        MOV   A,E       Get char back in A
        RNC             Abort if non-carry CALL
 REM
* On carry CALL only: accept !,%,$:
 REM
        CPI   :25
        JZ    :E727     Jump if char is '%'
        CPI   :21
        JZ    :E727     Jump if char is '!'
        CPI   :24
        RNZ             Abort if char is not '$'
L3E112  INR   C         Update line pos
        INR   D         Update count
        RET
*
*******************
* GET LINE NUMBER *
*******************
*
* Exit: C,HL: Updated.
*       B preserved, AFDE corrupted.
*       'SYNTAX ERROR' if no linenr given.
*
ELN     CALL  :E731     Read linenr into EBUF
        JNC   :DA0B     Run 'SYNTAX ERROR' if no
 REM number given
        RET
*
******************************
* READ LINE NUMBER INTO EBUF *
******************************
*
* Exit: CY=0: No linenumber given. Error exit if
*             linenumber is 0 or > #FFFF.
*       CY=1: O.K.
*       C,HL: Updated.
*       B preserved, AFDE corrupted.
*
L3E114  CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CALL  :C024     Input INT number to MACC
        RNC             Abort if no linenr given
        PUSH  B
        RST   4         Copy MACC into reg ABCD
        DATA  :15
        ORA   B
        JNZ   :E751     Error exit if > #FFFF
        ORA   C
        ORA   D
        JZ    :E751     Error exit if nr = 0
        MOV   E,D       ) Linenr in DE
        MOV   D,C       )
        MOV   M,D       Hibyte linenr into EBUF
        CALL  :E018     Update EBUF pointer
        MOV   M,E       Lobyte linenr into EBUF
        CALL  :E018     Update EBUF pointer
        POP   B
        STC             CY=1 (O.K.)
        RET
 REM
* Error exit:
 REM
L3E115  POP   B
        MVI   A,:15
        JMP   :D9F5     Run error 'NUMBER OUT OF
 REM RANGE'
*
*************************************
* ENCODE BINARY OPERATION INTO EBUF *
*************************************
*
* Entry: A : Result of 3E7CF:
*            1xx xxxxx : compute type / opcode.
*        E : Table code byte.
*        HL: 1st free location EBUF.
*
L3E116  PUSH  PSW
        MOV   A,E       Get conversion code byte
        XCHG
        LHLD  :013B     Get addr last operator in
 REM EBUF
        XCHG            in DE
        CALL  :E770     Add conversion byte for
 REM 2nd operand
        RRC
        RRC
        XCHG
        LHLD  :0139     Get addr in EBUF for next
 REM operator
        XCHG
        CALL  :E770     Add conversion byte for
 REM 1st operand
        POP   PSW       Restore compute/opcode in A
        CALL  :E783     Insert it into EBUF
        RET
*
*********************************************
* ADD INT/FPT CONVERSION BYTE TO EXPRESSION *
*********************************************
*
* Entry: A : Conversion byte:
*            #01: Convert FPT to INT.
*            #02: Convert INT to FPT.
*
L3E117  PUSH  PSW
        ANI   :03       Conversion only
        JZ    :E781     Jump if no conversion reqd
        RAR             CY=1 if FPT to INT
        MVI   A,:9F     Conv.byte FPT to INT
        JC    :E77E
        MVI   A,:BF     Conv.byte INT to FPT
L3E118  CALL  :E783     Insert conv.byte into EBUF
L3E119  POP   PSW
        RET
*
*************************
* INSERT BYTE INTO EBUF *
*************************
*
* Data is moved 1 byte to create space for byte
* to be inserted.
*
* Entry: A : Byte to be inserted.
*        DE: Startaddress source bank.
*        HL: Endaddress source bank +1.
* Exit:  HL= HL + 1.
*        ABCDE preserved.
*
L3E120  PUSH  B
        MOV   B,D       ) Start source in BC
        MOV   C,E       )
        INX   B         Destination 1 byte higher
        PUSH  PSW
        PUSH  D
        CALL  :E018     Update EBUF pointer
        PUSH  H
        DCX   H
        CALL  :DE4F     Move EBUF contents 1 byte
        POP   H
        POP   D
        POP   PSW
        STAX  D         Store byte into EBUF
        POP   B
        RET
*
*
*
*****************************************
* ENCODE AN UNITARY OPERATOR FOR A TERM *
*****************************************
*
* Entry: A : Code according to table CFD8.
* Exit:  BCHL preserved. DE corrupted.
*        A : Code byte:
*                  +    -   INOT
*            INT   BC   BD   BE
*            FPT   9C   9D   *
*
L3E121  PUSH  H
        LXI   H,:0136   Addr type last expression
        ANI   :1F       Opcode only
        CPI   :00       '+' ?
        MVI   D,:1C
        JZ    :E7BA     Then jump
        CPI   :01       '-' ?
        MVI   D,:1D
        JZ    :E7BA     Then jump
        CPI   :1E       'INOT' ?
        JNZ   :DA0B     Run 'SYNTAX ERROR' if not
 REM
* If 'INOT':
 REM
        MOV   A,M       Get type last expression
        CPI   :10       Must be INT
        JNZ   :DA1A     Run error 'TYPE MISMATCH'
 REM if not
        MVI   A,:BE     Code 'INOT' in A
L3E122  POP   H
        RET
 REM
* If '+' or '-':
 REM
L3E123  MOV   A,M       Get type last expression
        CPI   :10
        MVI   E,:A0
        JZ    :E7CA     Jump if INT
        MOV   A,M       Get type last expression
        CPI   :00
        MVI   E,:80
        JNZ   :DA1A     Run error 'TYPE MISMATCH'
 REM if not FPT
L3E124  MOV   A,D       ) Set up code in A
        ORA   E         )
        JMP   :E7B8
*
*****************************************
* OBTAIN TYPE INFO FOR BINARY OPERATION *
*****************************************
*
* Entry: A : Code for binary operation (lower 5
*            bits).
*        E : Type 1st operand.
*      TYPE: Type 2nd operand.
*
* Routine compares both types. If different, one
* must be INT and the other FPT, else type mismatch
* error.
* Type conversion and operation type are obtained
* from table on 3E835. Type mismatch if illegal
* type.
* Type of result is stored in TYPE.
*
* Exit: E : Type code from table.
*       A : Code for EBUF:  1xx xxxxx:
*           bits 5,6: type of compute required:
*                     0 : FPT
*                     1 : INT
*                     2 : STR
*                     3 : Boolean
*           bits 0-4: Opcode.
*       BCDHL preserved.
*
L3E125  PUSH  H
        PUSH  D
        ANI   :1F       Opcode only
        PUSH  PSW
        CALL  :E81F     Set D according to opcode
        LDA   :0136     Get type latest expression
        CMP   E         Compare both types
        JNZ   :E809     Jump if not identical
        RLC             )
        RLC             ) Type code from TYPE in
        RLC             ) lonibble
        RLC             )
        ANI   :03       Only lower 2 bits
        MOV   L,A       in L
L3E126  MOV   A,D       Get opcode group (0-5)
        ADD   A         *2
        MOV   D,A       in D
        ADD   A         *4
        ADD   D         *6 (find group in table)
        ADD   L         Find pos in grouptable
        LXI   H,:E835   Startaddr result table
        CALL  :DE30     Find addr resultcode in
 REM table
        MOV   A,M       Get resultcode
        INR   A         Check if code is FF
        JZ    :DA1A     Then run error 'TYPE
 REM MISMATCH'
        DCR   A
        ANI   :30       Get type of result only
        STA   :0136     Store type latest expression
        POP   D         Get code for binary
 REM operation in D
        MOV   E,M       ) Get resultcode from table
        MOV   A,M       ) in E and in A
        RAR
        ANI   :60       Reqd computing in bits 5,6
        ORA   D         Add opcode in bits 0-4
        ORI   :80       Set bit 7
        POP   H
        MOV   D,H       Restore D
        POP   H
        RET
 REM
* If both types not identical:
 REM
L3E127  MVI   L,:04
        CPI   :00       TYPE is FPT ?
        JZ    :E816     Then jump
        INR   L
        CPI   :10       TYPE is INT ?
        JNZ   :DA1A     Run error 'TYPE MISMATCH'
 REM if not
L3E128  ADD   E         Add other type
        CPI   :10       Result must be #10
        JNZ   :DA1A     Run error 'TYPE MISMATCH'
 REM if not
        JMP   :E7E5     Calc conversion
*
* SET D DEPENDING ON OPCODE BINARY OPERATOR:
*
* Entry: A : Opcode binary operator (table #CF91).
* Exit: ABCEHL preserved.
*
L3E129  MVI   D,:00     D=0
        CPI   :01
        RC              Ready if opcode is 0 (+)
        INR   D         D=1
        CPI   :04
        RC              Ready if opcode is 1,2 or
 REM 3 (-,/,*)
        MVI   D,:02     D=2
        RZ              Ready if opcode is 4 (^)
        INR   D         D=3
        CPI   :10
        RC              Ready if opcode is 5-F
 REM (IOR,IAND,IXOR,SHL,SHR,MOD)
        INR   D         D=4
        CPI   :18
        RC              Ready if opcode is 10-17
 REM (>=, <=, >, <, =, <>)
        INR   D         D=5
        RET             If opcode >= 18 (AND,OR)
*
* TABLE WITH TYPE RESULTS:
*
* The table gives the relation between input
* operands, the binary operator and the result
* for different groups of binary operations.
* The groupnumber is calculated in 3E81F.
*
* Format each group: 6 bytes. Sequence:
*             FPT/FPT
*             INT/INT
*             STR/STR
*             LOGIC/LOGIC
*             INT/FPT
*             FPT/INT
* Format each byte:
*       bit 7,6: type arithmetic ) 0: FPT  1: INT
*       bit 5,4: Type result     ) 2: STR  3: logic
*       bit 3,2: Conversion left operand.
*       bit 1,0: Conversion right operand.
*                0 : No conversion.
*                1 : Convert to INT.
*                2 : Convert to FPT.
*       FF : Not possible.
*
L3E385  DATA  :00       Group D=0:
        DATA  :50       +
        DATA  :A0
        DATA  :FF
        DATA  :08
        DATA  :02
*
        DATA  :00       Group D=1:
        DATA  :50       -,/,*
        DATA  :FF
        DATA  :FF
        DATA  :08
        DATA  :02
*
        DATA  :00       Group D=2:
        DATA  :0A       ^
        DATA  :FF
        DATA  :FF
        DATA  :08
        DATA  :02
*
        DATA  :55       Group D=3:
        DATA  :50       IAND,IOR,IXOR,MOD,SHL,SHR
        DATA  :FF
        DATA  :FF
        DATA  :51
        DATA  :54
*
        DATA  :30       Group D=4:
        DATA  :70       <,>,<>,=,<=,>=
        DATA  :B0
        DATA  :FF
        DATA  :38
        DATA  :32
*
        DATA  :FF       Group D=5:
        DATA  :FF       AND,OR
        DATA  :FF
        DATA  :F0
        DATA  :FF
        DATA  :FF
*
*
*
        END